home *** CD-ROM | disk | FTP | other *** search
- /*
- * REXX-SCRIPT für WRITE V 3.264
- * Dies Script unterstützt den Umgang mit dem
- * Amiga Oberon Compiler 3.0 von A+L.
- * Dieses Script mit den Parametern FIRST, CURRENT, PREV oder LIST aus
- * dem aktuellen Text heraus starten.
- */
-
- IF ~show('P',"WRITE")
- THEN DO
- say 'Dieses Script läuft nur, wenn WRITE bereits gestartet wurde !'
- exit 10
- END
-
- ADDRESS "WRITE"
-
- OPTIONS RESULTS
-
- 'VERSIONCHECK 3848 "OberonError.wrx"'
- IF RC~=0 THEN DO
- exit 10
- END
-
- /*** Argumentkontrolle ***/
-
- arg what
- if (what ~= "FIRST") & (what ~= "NEXT") & (what ~= "CURRENT") & (what ~= "PREV") & (what~="LIST") then do
- "MESSAGEOK (Fehler:\nDieses Script muß mit FIRST, CURRENT, PREV oder LIST\nals Argument aufgerufen werden !)"
- exit
- end
-
- /*** Open oberonsupport.library ***/
-
- libname = "oberonsupport.library"
-
- if ~show("L", libname) then do
- if ~addlib(libname, 0, -30, 1) then do
- text = "Fehler :\n'" || libname "'\n" || "konnte nicht gefunden werden"
- MESSAGEOK text
- end
- end
-
- /*** Filenamen holen ***/
-
- "GETVAR (_File)" /* Nur Filenamen (ohne Pfad) holen */
- filename = result
-
- if filename = "" then do
- "MESSAGEOK (Fehler:\nKein Filename)"
- exit
- end
-
- "GETVAR (_FileName)" /* Kompletten Filenamen (mit Pfad) holen */
- filename = result
-
- if right(filename,4) ~= ".mod" then do
- "MESSAGEOK (Fehler:\n'$_File$'\nist kein Oberon Sourcecode !)"
- exit
- end
-
- filename = filename || 'E'
-
- /*** Enthält Fehler ? ***/
-
- count = GETERRCOUNT(filename)
- if count < 0 then do
- "MESSAGEOK ('$_File$'\nenthält keine Fehler !)"
- exit
- end
-
- cnt = getclip("CurrentError")
-
- if cnt = "" then do
- cnt = 0
- end
-
- if what = "LIST" then do
- ShowErrorList()
- end
- if what = "FIRST" then do
- cnt = 0
- end;
- if what = "NEXT" then do
- cnt = cnt+1
- end;
- if what = "PREV" then do
- cnt = cnt-1
- end
-
- if cnt >= count then do
- "MESSAGEOK ('$_File$'\nenthält keine weiteren Fehler !)"
- exit
- end
-
- if cnt < 0 then do
- "MESSAGEOK (Erster Fehler\nbereits erreicht !)"
- exit
- end
-
- if ~GETERROR(filename, cnt, Error.) then do
- "MESSAGEOK (Fehler:\nKann Fehlerdatei nicht laden !)"
- exit
- end
-
- GOTO Error.column Error.line
-
- text = "Fehler Nr." cnt+1 "von" count || ":\n" || "`" || GETERRORTEXT(Error.num) || "'"
- text = Translate(text,"<>","()")
-
- MESSAGEOK "(" || text || ")"
-
- if ~setclip("CurrentError",cnt) then do
- "MESSAGEOK (Fehler:\nKann mir aktuellen Fehler nicht merken !)"
- end
-
- exit 0
-
- ShowErrorList:
-
- CLEARLIST 0
-
- do x = 0 to count-1
- if GETERROR(filename, x, Error.) then do
- text = x+1 || " " || "`" || GETERRORTEXT(Error.num) || "'"
- text = Translate(text,"<>","()")
- ADDLIST "(" || text || ")" 0
- end
- end
-
- SHOWLIST 0 cnt "{@SELECT}"
-
- if RC = 0 then do
- Text = result
- if Text~="" then do
- Error = Word(Text,1)
- cnt = Value(Error) - 1
-
- if ~GETERROR(filename, cnt, Error.) then do
- "MESSAGEOK (Fehler:\nKann Fehlerdatei nicht laden !)"
- exit
- end
-
- GOTO Error.column Error.line
-
- text = "Fehler Nr." cnt+1 "von" count || ":\n" || "`" || GETERRORTEXT(Error.num) || "'"
- text = Translate(text,"<>","()")
-
- MESSAGEOK "(" || text || ")"
-
- if ~setclip("CurrentError",cnt) then do
- "MESSAGEOK (Fehler:\nKann mir aktuellen Fehler nicht merken !)"
- end
- end
- end
-
- exit 0
-
-